Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyListWindowHeaders.p

Text File | 1995-07-05 | 5.2 KB | 237 lines | [TEXT/CWIE]

unit MyListWindowHeaders;

interface

    uses
        MyListWindow;

    const
        columns_max = 7;
        columns1 = columns_max + 1;

    type
        OffsetsArray = array[1..columns1] of integer;
        StringsArray = array[1..columns_max] of Str255;

    type
        ListWindowHeadersObject = object(ListWindowObject)
                columns: integer;
                headers_strh_id: integer;
                sort_column: integer;
                off: OffsetsArray;
                gap, baseoff, headeroff: integer;
                aligns: array[boolean] of string[columns_max];
                procedure LDEF (message: integer; select: boolean; var r: Rect; c: Cell; dataOffset, dataLen: integer);
                override;
                procedure DrawHeader (r: rect);
                override;
                procedure DoHeaderClick (r: rect; where: Point; modifiers: integer);
                override;
                procedure GetHeaderStrings (var ss: StringsArray);
                procedure Strings (index: integer; var ss: StringsArray);
                procedure GetStringRect (r: rect; col: integer; var ss: StringsArray; var ther: rect; header: boolean);
                procedure DrawStrings (r: rect; var ss: StringsArray; select, header: boolean; hilite: integer);
                procedure MaxStrings (var maxs: OffsetsArray; var ss: StringsArray);
                procedure GetMaxs (var maxs: OffsetsArray);
                procedure SetOffs;
            end;

implementation

    uses
        TextUtils, MyUtils;

    procedure ListWindowHeadersObject.GetHeaderStrings (var ss: StringsArray);
        var
            i: integer;
    begin
        for i := 1 to columns do begin
            GetIndString(ss[i], headers_strh_id, i);
        end;
    end;

    procedure ListWindowHeadersObject.Strings (index: integer; var ss: StringsArray);
        var
            i: integer;
    begin
        index:=index; { UNUSED! }
        for i := 1 to columns do begin
            ss[i] := '???';
        end;
    end;

    procedure ListWindowHeadersObject.MaxStrings (var maxs: OffsetsArray; var ss: StringsArray);
        var
            i, sw: integer;
    begin
        for i := 1 to columns do begin
            sw := StringWidth(ss[i]);
            if sw > maxs[i] then begin
                maxs[i] := sw;
            end;
        end;
    end;

    procedure ListWindowHeadersObject.GetMaxs (var maxs: OffsetsArray);
        var
            i: integer;
            ss: StringsArray;
    begin
        SetPort(window);
        for i := 1 to columns do begin
            maxs[i] := 0;
        end;
        GetHeaderStrings(ss);
        MaxStrings(maxs, ss);
    end;

    procedure ListWindowHeadersObject.SetOffs;
        var
            i: integer;
            maxs: OffsetsArray;
    begin
        GetMaxs(maxs);
        off[1] := gap;
        for i := 1 to columns do begin
            off[i + 1] := off[i] + maxs[i] + gap;
        end;
        SetListWidth(off[columns + 1]);
    end;

    procedure ListWindowHeadersObject.GetStringRect (r: rect; col: integer; var ss: StringsArray; var ther: rect; header: boolean);
        var
            sw: integer;
    begin
        sw := StringWidth(ss[col]);
        ther.top := r.top;
        ther.bottom := r.bottom;
        if header then begin
            ther.bottom := ther.bottom - 3;
        end;
        case aligns[header][col] of
            'L':  begin
                ther.left := r.left - list_offset + off[col];
            end;
            'R':  begin
                ther.left := r.left - list_offset + off[col + 1] - sw - gap;
            end;
            'C':  begin
                ther.left := r.left - list_offset + (off[col] + off[col + 1] - sw - gap) div 2;
            end;
        end;
        ther.right := ther.left + sw;
    end;

    procedure ListWindowHeadersObject.    DrawStrings (r: rect; var ss: StringsArray; select, header: boolean; hilite: integer);
        var
            ps: PenState;
            i: integer;
            ir: rect;
    begin
        SetPort(window);
        GetPenState(ps);
        PenNormal;
        EraseRect(r);

        for i := 1 to columns do begin
            GetStringRect(r, i, ss, ir, header);
            if header then begin
                MoveTo(ir.left, ir.bottom - headeroff);
            end
            else begin
                MoveTo(ir.left, ir.bottom - baseoff);
            end;
            if header and (hilite = i) then begin
                TextFace([underline]);
                DrawString(ss[i]);
                TextFace([]);
            end
            else begin
                DrawString(ss[i]);
            end;
        end;

        if select then begin
            HiliteInvertRect(r);
        end;

        SetPenState(ps);
    end;

    procedure ListWindowHeadersObject.DrawHeader (r: rect);
        var
            ss: StringsArray;
    begin
        GetHeaderStrings(ss);
        DrawStrings(r, ss, false, true, sort_column);
        MoveTo(r.left,r.bottom-2);
        LineTo(r.right,r.bottom-2);
    end;

    procedure ListWindowHeadersObject.DoHeaderClick (r: rect; where: Point; modifiers: integer);
        var
            i, j: integer;
            ir: rect;
            ss: StringsArray;
            on, newon: boolean;
    begin
        modifiers:=modifiers; { UNUSED! }
        j := -1;
        GetHeaderStrings(ss);
        for i := 1 to columns do begin
            GetStringRect(r, i, ss, ir, true);
            if PtInRect(where, ir) then begin
                j := i;
                leave;
            end;
        end;
        if (j > 0) & (j <> sort_column) then begin
            InsetRect(ir, -1, 1);
            InvertRect(ir);
            on := true;
            while StillDown do begin
                GetMouse(where);
                newon := PtInRect(where, ir);
                if newon <> on then begin
                    InvertRect(ir);
                    on := newon;
                end;
            end;
            if on then begin
                InvertRect(ir);
                sort_column := j;
                DrawStrings(r, ss, false, true, sort_column);
            end;
        end;
    end;

    procedure ListWindowHeadersObject.LDEF (message: integer; select: boolean; var r: Rect; c: Cell; dataOffset, dataLen: integer);
        procedure LDClose;
        begin
        end;

        procedure LDDraw;
            var
                ss: StringsArray;
        begin
            if datalen = 0 then begin
                Strings(c.v + 1, ss);
                DrawStrings(r, ss, select, false, 0);
            end;
        end;

    begin
        dataOffset:=dataOffset; { UNUSED! }
        case message of
            lInitMsg:
                ;
            lDrawMsg:
                LDDraw;
            lHiliteMsg:
                LDDraw;
            lCloseMsg:
                LDClose;
        end;
    end;

end.